home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
FAXCONV.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-04-20
|
16KB
|
481 lines
Unit FaxConv;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Conversion of .FAX TO .PCX file Last changed: 20.04.96 SA ║}
{║ ║}
{║ Original code by: Bo Bendtsen ║}
{║ (C) Copyright 1989-93 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given TO anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
Interface
USES Use32, Dos;
PROCEDURE FaxToPcx(FaxFilename: PathStr);
IMPLEMENTATION
USES OpRoot, OpString,
Util, Display;
TYPE
PCXHdr = record
manufacturer : Byte;
version : Byte;
encode_mode : Byte;
bits_per_pixel : Byte;
start_x : Word;
start_y : Word;
end_x : Word;
end_y : Word;
x_resolution : Word;
y_resolution : Word;
palette_RGB : array[1..48] of Byte;
vmode : Byte; {ignored}
planes : Byte;
bytes_per_line : Word;
unused : array[1..60] of Byte;
END;
Fax1dRecord = Record
Data,
Mask : Word;
Size : Byte;
Value : Word;
END;
BmpLineType = Array[1..216] of Byte;
Const
WhiteMakeUp : Array[1..27] of Fax1dRecord = (
(Data:$1b00;Mask:$1f00;Size: 5;Value: 0),
(Data:$1200;Mask:$1f00;Size: 5;Value: 1),
(Data:$0b80;Mask:$1f80;Size: 6;Value: 2),
(Data:$0dc0;Mask:$1fc0;Size: 7;Value: 3),
(Data:$06c0;Mask:$1fe0;Size: 8;Value: 4),
(Data:$06e0;Mask:$1fe0;Size: 8;Value: 5),
(Data:$0c80;Mask:$1fe0;Size: 8;Value: 6),
(Data:$0ca0;Mask:$1fe0;Size: 8;Value: 7),
(Data:$0d00;Mask:$1fe0;Size: 8;Value: 8),
(Data:$0ce0;Mask:$1fe0;Size: 8;Value: 9),
(Data:$0cc0;Mask:$1ff0;Size: 9;Value:10),
(Data:$0cd0;Mask:$1ff0;Size: 9;Value:11),
(Data:$0d20;Mask:$1ff0;Size: 9;Value:12),
(Data:$0d30;Mask:$1ff0;Size: 9;Value:13),
(Data:$0d40;Mask:$1ff0;Size: 9;Value:14),
(Data:$0d50;Mask:$1ff0;Size: 9;Value:15),
(Data:$0d60;Mask:$1ff0;Size: 9;Value:16),
(Data:$0d70;Mask:$1ff0;Size: 9;Value:17),
(Data:$0d80;Mask:$1ff0;Size: 9;Value:18),
(Data:$0d90;Mask:$1ff0;Size: 9;Value:19),
(Data:$0da0;Mask:$1ff0;Size: 9;Value:20),
(Data:$0db0;Mask:$1ff0;Size: 9;Value:21),
(Data:$0980;Mask:$1ff0;Size: 9;Value:22),
(Data:$0990;Mask:$1ff0;Size: 9;Value:23),
(Data:$09a0;Mask:$1ff0;Size: 9;Value:24),
(Data:$0c00;Mask:$1f80;Size: 6;Value:25),
(Data:$09b0;Mask:$1ff0;Size: 9;Value:26) );
FaxWhite : Array[1..64] of Fax1dRecord = (
(Data:$06a0;Mask:$1fe0;Size: 8;Value: 0),
(Data:$0380;Mask:$1f80;Size: 6;Value: 1),
(Data:$0e00;Mask:$1e00;Size: 4;Value: 2),
(Data:$1000;Mask:$1e00;Size: 4;Value: 3),
(Data:$1600;Mask:$1e00;Size: 4;Value: 4),
(Data:$1800;Mask:$1e00;Size: 4;Value: 5),
(Data:$1c00;Mask:$1e00;Size: 4;Value: 6),
(Data:$1e00;Mask:$1e00;Size: 4;Value: 7),
(Data:$1300;Mask:$1f00;Size: 5;Value: 8),
(Data:$1400;Mask:$1f00;Size: 5;Value: 9),
(Data:$0700;Mask:$1f00;Size: 5;Value:10),
(Data:$0800;Mask:$1f00;Size: 5;Value:11),
(Data:$0400;Mask:$1f80;Size: 6;Value:12),
(Data:$0180;Mask:$1f80;Size: 6;Value:13),
(Data:$1a00;Mask:$1f80;Size: 6;Value:14),
(Data:$1a80;Mask:$1f80;Size: 6;Value:15),
(Data:$1500;Mask:$1f80;Size: 6;Value:16),
(Data:$1580;Mask:$1f80;Size: 6;Value:17),
(Data:$09c0;Mask:$1fc0;Size: 7;Value:18),
(Data:$0300;Mask:$1fc0;Size: 7;Value:19),
(Data:$0200;Mask:$1fc0;Size: 7;Value:20),
(Data:$05c0;Mask:$1fc0;Size: 7;Value:21),
(Data:$00c0;Mask:$1fc0;Size: 7;Value:22),
(Data:$0100;Mask:$1fc0;Size: 7;Value:23),
(Data:$0a00;Mask:$1fc0;Size: 7;Value:24),
(Data:$0ac0;Mask:$1fc0;Size: 7;Value:25),
(Data:$04c0;Mask:$1fc0;Size: 7;Value:26),
(Data:$0900;Mask:$1fc0;Size: 7;Value:27),
(Data:$0600;Mask:$1fc0;Size: 7;Value:28),
(Data:$0040;Mask:$1fe0;Size: 8;Value:29),
(Data:$0060;Mask:$1fe0;Size: 8;Value:30),
(Data:$0340;Mask:$1fe0;Size: 8;Value:31),
(Data:$0360;Mask:$1fe0;Size: 8;Value:32),
(Data:$0240;Mask:$1fe0;Size: 8;Value:33),
(Data:$0260;Mask:$1fe0;Size: 8;Value:34),
(Data:$0280;Mask:$1fe0;Size: 8;Value:35),
(Data:$02a0;Mask:$1fe0;Size: 8;Value:36),
(Data:$02c0;Mask:$1fe0;Size: 8;Value:37),
(Data:$02e0;Mask:$1fe0;Size: 8;Value:38),
(Data:$0500;Mask:$1fe0;Size: 8;Value:39),
(Data:$0520;Mask:$1fe0;Size: 8;Value:40),
(Data:$0540;Mask:$1fe0;Size: 8;Value:41),
(Data:$0560;Mask:$1fe0;Size: 8;Value:42),
(Data:$0580;Mask:$1fe0;Size: 8;Value:43),
(Data:$05a0;Mask:$1fe0;Size: 8;Value:44),
(Data:$0080;Mask:$1fe0;Size: 8;Value:45),
(Data:$00a0;Mask:$1fe0;Size: 8;Value:46),
(Data:$0140;Mask:$1fe0;Size: 8;Value:47),
(Data:$0160;Mask:$1fe0;Size: 8;Value:48),
(Data:$0a40;Mask:$1fe0;Size: 8;Value:49),
(Data:$0a60;Mask:$1fe0;Size: 8;Value:50),
(Data:$0a80;Mask:$1fe0;Size: 8;Value:51),
(Data:$0aa0;Mask:$1fe0;Size: 8;Value:52),
(Data:$0480;Mask:$1fe0;Size: 8;Value:53),
(Data:$04a0;Mask:$1fe0;Size: 8;Value:54),
(Data:$0b00;Mask:$1fe0;Size: 8;Value:55),
(Data:$0b20;Mask:$1fe0;Size: 8;Value:56),
(Data:$0b40;Mask:$1fe0;Size: 8;Value:57),
(Data:$0b60;Mask:$1fe0;Size: 8;Value:58),
(Data:$0940;Mask:$1fe0;Size: 8;Value:59),
(Data:$0960;Mask:$1fe0;Size: 8;Value:60),
(Data:$0640;Mask:$1fe0;Size: 8;Value:61),
(Data:$0660;Mask:$1fe0;Size: 8;Value:62),
(Data:$0680;Mask:$1fe0;Size: 8;Value:63) );
BlackMakeUp : Array[1..27] of Fax1dRecord = (
(Data:$0078;Mask:$1ff8;Size:10;Value: 0),
(Data:$0190;Mask:$1ffe;Size:12;Value: 1),
(Data:$0192;Mask:$1ffe;Size:12;Value: 2),
(Data:$00b6;Mask:$1ffe;Size:12;Value: 3),
(Data:$0066;Mask:$1ffe;Size:12;Value: 4),
(Data:$0068;Mask:$1ffe;Size:12;Value: 5),
(Data:$006a;Mask:$1ffe;Size:12;Value: 6),
(Data:$006c;Mask:$1fff;Size:13;Value: 7),
(Data:$006d;Mask:$1fff;Size:13;Value: 8),
(Data:$004a;Mask:$1fff;Size:13;Value: 9),
(Data:$004b;Mask:$1fff;Size:13;Value:10),
(Data:$004c;Mask:$1fff;Size:13;Value:11),
(Data:$004d;Mask:$1fff;Size:13;Value:12),
(Data:$0072;Mask:$1fff;Size:13;Value:13),
(Data:$0073;Mask:$1fff;Size:13;Value:14),
(Data:$0074;Mask:$1fff;Size:13;Value:15),
(Data:$0075;Mask:$1fff;Size:13;Value:16),
(Data:$0076;Mask:$1fff;Size:13;Value:17),
(Data:$0077;Mask:$1fff;Size:13;Value:18),
(Data:$0052;Mask:$1fff;Size:13;Value:19),
(Data:$0053;Mask:$1fff;Size:13;Value:20),
(Data:$0054;Mask:$1fff;Size:13;Value:21),
(Data:$0055;Mask:$1fff;Size:13;Value:22),
(Data:$005a;Mask:$1fff;Size:13;Value:23),
(Data:$005b;Mask:$1fff;Size:13;Value:24),
(Data:$0064;Mask:$1fff;Size:13;Value:25),
(Data:$0065;Mask:$1fff;Size:13;Value:26) );
FaxBlack : Array[1..64] of Fax1dRecord = (
(Data:$01b8;Mask:$1ff8;Size:10;Value: 0),
(Data:$0800;Mask:$1c00;Size: 3;Value: 1),
(Data:$1800;Mask:$1800;Size: 2;Value: 2),
(Data:$1000;Mask:$1800;Size: 2;Value: 3),
(Data:$0c00;Mask:$1c00;Size: 3;Value: 4),
(Data:$0600;Mask:$1e00;Size: 4;Value: 5),
(Data:$0400;Mask:$1e00;Size: 4;Value: 6),
(Data:$0300;Mask:$1f00;Size: 5;Value: 7),
(Data:$0280;Mask:$1f80;Size: 6;Value: 8),
(Data:$0200;Mask:$1f80;Size: 6;Value: 9),
(Data:$0100;Mask:$1fc0;Size: 7;Value:10),
(Data:$0140;Mask:$1fc0;Size: 7;Value:11),
(Data:$01c0;Mask:$1fc0;Size: 7;Value:12),
(Data:$0080;Mask:$1fe0;Size: 8;Value:13),
(Data:$00e0;Mask:$1fe0;Size: 8;Value:14),
(Data:$0180;Mask:$1ff0;Size: 9;Value:15),
(Data:$00b8;Mask:$1ff8;Size:10;Value:16),
(Data:$00c0;Mask:$1ff8;Size:10;Value:17),
(Data:$0040;Mask:$1ff8;Size:10;Value:18),
(Data:$019c;Mask:$1ffc;Size:11;Value:19),
(Data:$01a0;Mask:$1ffc;Size:11;Value:20),
(Data:$01b0;Mask:$1ffc;Size:11;Value:21),
(Data:$00dc;Mask:$1ffc;Size:11;Value:22),
(Data:$00a0;Mask:$1ffc;Size:11;Value:23),
(Data:$005c;Mask:$1ffc;Size:11;Value:24),
(Data:$0060;Mask:$1ffc;Size:11;Value:25),
(Data:$0194;Mask:$1ffe;Size:12;Value:26),
(Data:$0196;Mask:$1ffe;Size:12;Value:27),
(Data:$0198;Mask:$1ffe;Size:12;Value:28),
(Data:$019a;Mask:$1ffe;Size:12;Value:29),
(Data:$00d0;Mask:$1ffe;Size:12;Value:30),
(Data:$00d2;Mask:$1ffe;Size:12;Value:31),
(Data:$00d4;Mask:$1ffe;Size:12;Value:32),
(Data:$00d6;Mask:$1ffe;Size:12;Value:33),
(Data:$01a4;Mask:$1ffe;Size:12;Value:34),
(Data:$01a6;Mask:$1ffe;Size:12;Value:35),
(Data:$01a8;Mask:$1ffe;Size:12;Value:36),
(Data:$01aa;Mask:$1ffe;Size:12;Value:37),
(Data:$01ac;Mask:$1ffe;Size:12;Value:38),
(Data:$01ae;Mask:$1ffe;Size:12;Value:39),
(Data:$00d8;Mask:$1ffe;Size:12;Value:40),
(Data:$00da;Mask:$1ffe;Size:12;Value:41),
(Data:$01b4;Mask:$1ffe;Size:12;Value:42),
(Data:$01b6;Mask:$1ffe;Size:12;Value:43),
(Data:$00a8;Mask:$1ffe;Size:12;Value:44),
(Data:$00aa;Mask:$1ffe;Size:12;Value:45),
(Data:$00ac;Mask:$1ffe;Size:12;Value:46),
(Data:$00ae;Mask:$1ffe;Size:12;Value:47),
(Data:$00c8;Mask:$1ffe;Size:12;Value:48),
(Data:$00ca;Mask:$1ffe;Size:12;Value:49),
(Data:$00a4;Mask:$1ffe;Size:12;Value:50),
(Data:$00a6;Mask:$1ffe;Size:12;Value:51),
(Data:$0048;Mask:$1ffe;Size:12;Value:52),
(Data:$006e;Mask:$1ffe;Size:12;Value:53),
(Data:$0070;Mask:$1ffe;Size:12;Value:54),
(Data:$004e;Mask:$1ffe;Size:12;Value:55),
(Data:$0050;Mask:$1ffe;Size:12;Value:56),
(Data:$00b0;Mask:$1ffe;Size:12;Value:57),
(Data:$00b2;Mask:$1ffe;Size:12;Value:58),
(Data:$0056;Mask:$1ffe;Size:12;Value:59),
(Data:$0058;Mask:$1ffe;Size:12;Value:60),
(Data:$00b4;Mask:$1ffe;Size:12;Value:61),
(Data:$00cc;Mask:$1ffe;Size:12;Value:62),
(Data:$00ce;Mask:$1ffe;Size:12;Value:63) );
EOLRUN : Fax1dRecord = (Data:$0002;Mask:$1ffe;Size:12;Value:0);
Procedure FaxToPcx(FaxFilename: PathStr);
Var
chf : Byte;
dataword : Word;
dataword1 : Word;
counter : Byte;
buftop : Byte;
EOL_count : Word;
EOL_co : Word;
flag : Boolean;
FaxSize : Longint;
BytesLeft : Longint;
PosX : Word;
PosY : Word;
IO : Word;
x,y,z : Word;
BmpLine : BmpLineType;
PCX : PCXHdr;
FaxFile,
PCXFile : BufIDStreamPtr;
Gauge : PGauge;
Procedure BmpPixel(Pos:Word);
Var
w:word;
b:Byte;
BEGIN
Dec(Pos);
b:=(Pos Shr 3)+1;
w:=$80 shr (Pos-(Pos Shr 3 SHL 3));
BmpLine[b]:=BmpLine[b] AND not w;
END;
PROCEDURE PutPCXLine(Count: Byte);
var
Last, CPtr, RunCount: Byte;
PROCEDURE PutPCXByte (Wert, Count: Byte);
BEGIN
IF (Count=1) AND ($C0 <> $C0 AND Wert) THEN
BEGIN
PCXFile^.Write(Wert,1);
END ELSE
BEGIN
Count := $C0 or Count;
PCXFile^.Write(Count,1);
PCXFile^.Write(Wert,1);
END;
END;
BEGIN
Last := BmpLine[1];
RunCount := 1;
FOR CPtr := 1 TO Count-1 DO
BEGIN
IF BmpLine[CPtr+1] = Last THEN
BEGIN
Inc (RunCount);
IF RunCount = 62 THEN
BEGIN
PutPCXByte(Last, RunCount);
RunCount := 0;
END;
END ELSE
BEGIN
PutPCXByte(Last,RunCount);
Last := BmpLine[CPtr+1];
RunCount := 1;
END;
END;
IF RunCount>0 THEN PutPCXByte(Last,RunCount);
END;
BEGIN
New(FaxFile, Init(FaxFileName, SOpenRead, Max64k((MaxAvail-1024) DIV 2)));
IF FaxFile=Nil THEN Exit;
New(PCXFile, Init(ForceExtension(FaxFileName, 'PCX'), SCreate, Max64k((MaxAvail-1024) DIV 2)));
IF PCXFile=Nil THEN Exit;
NEW(Gauge,Init(9,2,'Converting to PCX',FaxFile^.GetSize));
chf:=$FF;
dataword:=$FFFF;
dataword1:=$FFFF;
counter:=0;
buftop:=0;
EOL_count:=0;
EOL_co:=0;
flag:=False;
FaxSize:=0;
BytesLeft:=0;
PosX:=0;
PosY:=0;
IO:=0;
Fillchar(PCX,Sizeof(PCX),0);
With PCX DO
BEGIN
manufacturer := 10;
version := 2;
encode_mode := 1;
bits_per_pixel := 1;
end_x := 1727;
Fillchar(palette_RGB,48,255);
palette_RGB[1] := 0;
palette_RGB[2] := 0;
palette_RGB[3] := 0;
planes := 1;
bytes_per_line := 216;
END;
PCXFile^.Write(PCX,Sizeof(Pcx));
BytesLeft:=FaxFile^.GetSize;
FaxSize:=BytesLeft;
Fillchar(BmpLine,Sizeof(BmpLine),255);
WHILE (bytesleft>0) DO
BEGIN
WHILE buftop<13 DO
BEGIN
IF Counter=0 THEN
BEGIN
Dec(BytesLeft);
IF BytesLeft=0 THEN Break;
FaxFile^.Read(chf, 1);
counter:=8;
END;
dataword:=dataword SHL 1;
IF chf AND $80=$80 THEN dataword:=dataword or 1;
chf:=chf SHL 1;
Dec(counter);
Inc(buftop);
END;
IF EOL_co=0 THEN
BEGIN
dataword1:=dataword AND EOLRUN.mask;
IF dataword1=EOLRUN.data THEN
BEGIN
Dec(buftop,EOLRUN.size);
Inc(EOL_count);
EOL_co:=1;
flag:=False;
PosX:=0;
Inc(PosY);
PutPCXLine(216);
Fillchar(BmpLine,Sizeof(BmpLine),255);
Gauge^.Update(FaxFile^.GetPos);
END;
IF buftop>=13 THEN Dec(BufTop);
END;
IF (EOL_co=1) AND Flag THEN
BEGIN
EOL_co:=2;
Flag:=False;
FOR x:=1 TO 27 DO
BEGIN
dataword1:=dataword AND WhiteMakeUp[x].mask;
IF dataword1=WhiteMakeUp[x].data THEN
BEGIN
Inc(PosX,x*64);
Dec(buftop,WhiteMakeUp[x].size);
break;
END;
END;
END;
IF (EOL_co=2) AND Flag THEN
BEGIN
EOL_co:=0;
Flag:=False;
FOR x:=1 TO 64 DO
BEGIN
dataword1:=dataword AND FaxWhite[x].mask;
IF dataword1=FaxWhite[x].data THEN
BEGIN
Inc(PosX,FaxWhite[x].value);
Dec(buftop,FaxWhite[x].size);
EOL_co:=3;
break;
END;
END;
END;
IF (EOL_co=3) AND Flag THEN
BEGIN
EOL_co:=4;
Flag:=False;
FOR x:=1 TO 27 DO
BEGIN
dataword1:=dataword AND BlackMakeUp[x].mask;
IF dataword1=BlackMakeUp[x].data THEN
BEGIN
y:=x*64+PosX-1; IF y>1728 THEN y:=1728;
FOR z:=PosX TO y DO BmpPixel(z);
Inc(PosX,x*64);
Dec(buftop,BlackMakeUp[x].size);
break;
END;
END;
END;
IF (EOL_co=4) AND Flag THEN
BEGIN
EOL_co:=0;
Flag:=False;
FOR x:=1 TO 64 DO
BEGIN
dataword1:=dataword AND FaxBlack[x].mask;
IF dataword1=FaxBlack[x].data THEN
BEGIN
y:=PosX+FaxBlack[x].value-1;
IF y>1728 THEN y:=1728;
FOR z:=PosX TO y DO BmpPixel(z);
Inc(PosX,FaxBlack[x].value);
Dec(buftop,FaxBlack[x].size);
EOL_co:=1;
break;
END;
END;
END;
Flag:=True;
END; { bytesleft>0 }
Dispose(FaxFile, Done);
Dispose(Gauge,Done);
PCXFile^.Seek(0);
PCX.end_y:=PosY-1;
PCXFile^.Write(PCX,Sizeof(Pcx));
Dispose(PCXFile, Done);
END;
END.